home *** CD-ROM | disk | FTP | other *** search
/ F1 Licenseware / F1 Licenseware - Volume 1.iso / disks / 055a.dms / 055a.adf / colours.LHA / COLOURS.AMOS / COLOURS.amosSourceCode < prev    next >
AMOS Source Code  |  1980-01-05  |  8KB  |  222 lines
  1. '******************************************************************
  2. '* COLOUR PROCEDURES & DEMO PROG CODED BY ANDY DOBINSON FOR ISSUE *
  3. '*      4 OF AMOSZINE, On 8 OCTOBER 1994 While I WAS BORED        *
  4. '*                                                                *  
  5. '* THIS PROGRAM IS NOT TO APPEAR ON ANY OTHER DISKMAG OTHER THAN  *  
  6. '* AMOSZINE ISSUE 4 THE RESASON BEING IS THAT IM AM FED UP WITH   *
  7. '* SEEING THE SAME SOURCE CODE ON NEARLY EVERY AMOS DISKMAG AND   *
  8. '* TO BE HONEST ITS GETTING REDICULOUS, INFACT ONE DISKMAG THAT   *
  9. '* I GOT HOLD OF A FEW MONTHS AGO HAD THE ENTIRE SOURCE CODE ON   *  
  10. '* IT FROM BRIAN BELLS MAC ISSUE 6 ,WHAT WAS THE POINT IN DOING   *
  11. '* THAT.?                                                         *
  12. '******************************************************************
  13. Unpack 10 To 0 : Unpack 11 To 1 : Screen 1
  14.  
  15. Shift Up 1,2,28,1 : Wait Vbl : Screen Open 2,640,8,2,Hires
  16. Flash Off : Curs Off : Cls 0 : Colour 0,$0 : Colour 1,$FFF
  17. Screen Display 2,128,54,640,7 : Pen 1 : Paper 0
  18.  
  19. Screen 2
  20. Print "   COLOUR PROCEDURE'S & DEMO PROG CODED BY ANDY DOBINSON FOR AMOSZINE ISSUE 4";
  21. Screen Open 3,640,60,4,Hires : Screen Display 3,128,242,640,60
  22. Flash Off : Curs Off : Cls 0
  23. Colour 0,$0 : Colour 3,$FFF : Pen 3 : Paper 0 : Home 
  24. Print "         Right first of all lets do some copper spreading using the copper"
  25. Print "         spread procedure. now those of you who have got issue 1 will know"
  26. Print "that there was a procedure to do this anyway,but mine takes up a lot less code"
  27.  
  28. For T=0 To 10
  29. Screen 0
  30. A=Rnd(4095)
  31. B=Rnd(4095)
  32. _COPPER_SPREAD_[A,B,0,150,1,1]
  33. Next T
  34. _COPPER_SPREAD_[$F00,$FF0,0,150,1,1]
  35.  
  36. Screen 3
  37. Cls 0 : Home 
  38. Print "                              PRESS ANY KEY              "
  39. Wait Key 
  40. Screen 3
  41. Cls 0 : Home 
  42. Print "          Now we have got our picture on screen we want to fade it"
  43. Print "         but first we must reserVe a palette bank using the palette"
  44. Print "                   reserve procedure   PRESS ANY KEY"
  45. Wait Key 
  46. _RESERVE_AS_PALETTE_BANK_[9,10]
  47. Cls 0 : Home : List Bank 
  48. Print "           and as you can see there should a bank called DATA"
  49. Print "                             PRESS A KEY "
  50. Wait Key : Cls 0 : Home 
  51. Print "        now lets send our palette to the bank using the _palette_to_bank"
  52. Print "          procedure and fade the screen as usual using the fade command"
  53. Print "                             PRESS ANY KEY"
  54. Screen 0
  55. _PALETTE_TO_BANK_[9,1]
  56. Wait Key 
  57. Screen 0 : Fade 3 : Wait 50
  58. Screen 3 : Cls 0 : Home 
  59. Print "          Right now lets fade in using the FADE_BANK_TO_SCREEN procedure"
  60. Print "                                  PRESS ANY KEY"
  61. Wait Key : Screen 0
  62. _FADE_BANK_TO_SCREEN_[9,1,5,0]
  63. Screen 3 : Cls 0 : Home 
  64. Print "          Now lets darken the screen using the DARKEN_SCREEN procedure"
  65. Print "                                  PRESS ANY KEY"
  66. Wait Key : Screen 0
  67. _DARKEN_SCREEN_[3,8,16]
  68. Screen 3 : Cls 0 : Home 
  69. Print "                and then restore the colours from the palette bank"
  70. Print "                                  PRESS ANY KEY"
  71. Wait Key : Screen 0
  72. _FADE_BANK_TO_SCREEN_[9,1,5,0]
  73. ' Before you use any of the following instructions.. 
  74. ' _PALETTE_FROM_BANK_  
  75. ' _PALETTE_TO_BANK_  
  76. ' _FADE_BANK_TO_SCREEN_
  77. ' You must first reserve a palette bank using the next procedure 
  78. '  
  79. Procedure _RESERVE_AS_PALETTE_BANK_[_BANK_NUMBER,NUMBER_OF_PALETTES]
  80.    Reserve As Data _BANK_NUMBER,2+(128*NUMBER_OF_PALETTES)
  81.    T$="Palette."
  82.    'Poke$ Start(_BANK_NUMBER)-8,Left$(T$,8) 
  83.    Doke Start(_BANK_NUMBER),NUMBER_OF_PALETTES
  84. End Proc
  85. '
  86. ' this next procedure takes your current screen palette and
  87. ' and dokes it into the specified memory bank. 
  88. '
  89. Procedure _PALETTE_TO_BANK_[_BANK_NUMBER,_PALETTE_NUMBER]
  90.    If Length(_BANK_NUMBER)<2 Then Pop Proc
  91.    If _PALETTE_NUMBER>Deek(Start(_BANK_NUMBER)) Then Pop Proc
  92.    A=(Screen Colour)-1
  93.    For T=0 To A
  94.       Doke Start(_BANK_NUMBER)+2+_PALETTE_NUMBER*64+T*2,Colour(T)
  95.    Next T
  96. End Proc
  97. '
  98. ' This next procedure allows you to extract a palette from 
  99. ' from the specified bank to the current screen
  100. '
  101. Procedure _PALETTE_FROM_BANK_[_BANK_NUMBER,_PALETTE_NUMBER]
  102.    If Length(_BANK_NUMBER)<2 Then Pop Proc
  103.    If _PALETTE_NUMBER>Deek(Start(_BANK_NUMBER)) Then Pop Proc
  104.    A=(Screen Colour)-1
  105.    For T=0 To A
  106.       Colour T,Deek(Start(_BANK_NUMBER)+2+_PALETTE_NUMBER*64+T*2)
  107.    Next T
  108. End Proc
  109. '
  110. ' this next one allows you to spread a colour between two colour 
  111. ' indexes just like the spread option in duluxe paint
  112. ' IT DOES NOT AFFECT ANY DATA HELD IN A PALETTE BANK 
  113. '  
  114. Procedure _COLOUR_SPREAD_[_COL1,_COL2]
  115.    If A=0 Then Dim RED(31),GREEN(31),BLUE(31) : A=1
  116.    For T=_COL1 To _COL2
  117.       RED(T)=(Colour(T)/256)
  118.       GREEN(T)=(Colour(T)/16 mod 16)
  119.       BLUE(T)=(Colour(T) mod 16)
  120.    Next T
  121.    For T=_COL1 To _COL2 Step Sgn(_COL2-_COL1)
  122.       RED(T)=RED(_COL1)+((RED(_COL2)-RED(_COL1))*(T-_COL1))/(_COL2-_COL1)
  123.       GREEN(T)=GREEN(_COL1)+((GREEN(_COL2)-GREEN(_COL1))*(T-_COL1))/(_COL2-_COL1)
  124.       BLUE(T)=BLUE(_COL1)+((BLUE(_COL2)-BLUE(_COL1))*(T-_COL1))/(_COL2-_COL1)
  125.       Colour T,RED(T)*256+GREEN(T)*16+BLUE(T)
  126.    Next T
  127. End Proc
  128. '
  129. ' This ones a bit simple, it just allows you to swap two colours 
  130. ' around in the current screen.
  131. ' IT DOES NOT AFFECT ANY DATA HELD IN A PALETTE BANK 
  132. '  
  133. Procedure _COLOUR_SWAP_[_COL1,_COL2]
  134. A=Colour(_COL1)
  135. B=Colour(_COL2)
  136. Colour _COL1,Colour(B)
  137. Colour _COL2,Colour(A)
  138. End Proc
  139. '
  140. ' This next one allows you to darken the current screen
  141. ' very handy if you want to scroll text over it .
  142. ' IT DOES NOT AFFECT ANY DATA HELD IN A PALETTE BANK 
  143. '
  144. Procedure _DARKEN_SCREEN_[SPEED,_STEPS,_NUMBER_OFF_COLOURS]
  145.    For G=0 To _STEPS
  146.       For T=0 To _NUMBER_OFF_COLOURS
  147.          RED=(Colour(T)/256)
  148.          GREEN=(Colour(T)/16 mod 16)
  149.          BLUE=(Colour(T) mod 16)
  150.          Add RED,-1
  151.          Add GREEN,-1
  152.          Add BLUE,-1
  153.          If RED<0 Then RED=0
  154.          If GREEN<0 Then GREEN=0
  155.          If BLUE<0 Then BLUE=0
  156.          Colour T,RED*256+GREEN*16+BLUE
  157.       Next T
  158.       Wait Vbl 
  159.    Next G
  160. End Proc
  161. '
  162. ' xnow this one finds the brightest colour in the current
  163. ' screen palette, i've used the procedure that allows you to return  
  164. ' a value so to use it do this 
  165. '
  166. '                        _brightest_colour_
  167. '                        ink Param 
  168. '                        or
  169. '                        your variable = Param 
  170. 'IT DOES NOT AFFECT ANY DATA HELD IN A PALETTE BANK  
  171. '
  172. Procedure _BRIGHTEST_COLOUR_
  173.    A=0
  174.    E=0
  175.    B=Screen Colour-1
  176.    For C=0 To B
  177.       D=Colour(C)
  178.       If D>A Then E=C : A=D
  179.    Next C
  180. End Proc[E]
  181. '
  182. ' this one allows you to fade in your palette to the screen from 
  183. ' a palette stored inthe specified bank. 
  184. 'IT DOES NOT AFFECT ANY DATA HELD IN A PALETTE BANK  
  185. '
  186. Procedure _FADE_BANK_TO_SCREEN_[_BANK_NUMBER,_PALETTE_NUMBER,_SPEED,_SCREEN]
  187.    D=Screen Colour
  188.  
  189.    Screen Open 7,16,16,D,L
  190.    Screen Hide 7
  191.    Flash Off 
  192.    Screen 7
  193.    If Length(_BANK_NUMBER)<2 Then Pop Proc
  194.    If _PALETTE_NUMBER>Deek(Start(_BANK_NUMBER)) Then Pop Proc
  195.    A=D-1
  196.    For T=0 To A
  197.       Colour T,Deek(Start(_BANK_NUMBER)+2+_PALETTE_NUMBER*64+T*2)
  198.    Next T
  199.    Screen _SCREEN
  200.    Fade _SPEED To 7
  201.    Wait _SPEED*15
  202.    Screen Close 7
  203. End Proc
  204. Procedure _COPPER_SPREAD_[_COL1,_COL2,_START,_END,_RAIN_NUM,_COLOUR_INDEX]
  205.  
  206.    
  207.    If A=0 Then Dim RED(255),GREEN(255),BLUE(255) : A=1
  208.    
  209.    Set Rainbow _RAIN_NUM,_COLOUR_INDEX,255,"","",""
  210.    
  211.    RED(_END)=(_COL2/256) : GREEN(_END)=(_COL2/16 mod 16) : BLUE(_END)=(_COL2 mod 16)
  212.    RED(_START)=(_COL1/256) : GREEN(_START)=(_COL1/16 mod 16) : BLUE(_START)=(_COL1 mod 16)
  213.    For T=_START To _END
  214.       RED=RED(_START)+((RED(_END)-RED(_START))*(T-_START))/(_END-_START)
  215.       GREEN=GREEN(_START)+((GREEN(_END)-GREEN(_START))*(T-_START))/(_END-_START)
  216.       BLUE=BLUE(_START)+((BLUE(_END)-BLUE(_START))*(T-_START))/(_END-_START)
  217.       Rain(_RAIN_NUM,T)=RED*256+GREEN*16+BLUE
  218.  
  219.    Next T
  220.    Rainbow _RAIN_NUM,0,40,245
  221.    Wait Vbl 
  222. End Proc